home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpu6.zip / TPU6.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-17  |  48KB  |  1,483 lines
  1. {$D-,L-,S+,R-,E-,N-}
  2. PROGRAM TPU6;
  3. USES TPU6EQU, TPU6UTL, TPU6AMS, TPU6RPT, TPU6UNA,Dos,Crt;
  4.  
  5. TYPE
  6.    MethodName    = String[127];
  7.    HeadProc    = PROCEDURE;
  8.    LGClass   = (
  9.            LG_ABSQ,        {Absolute Equivalence}
  10.                 LG_ARBC,        {Array Bounds}
  11.                 LG_ASGN,        {Biggest Assgn Compat Type}
  12.                 LG_BASE,        {Base Type}
  13.                LG_CONS,        {Const Type}
  14.                 LG_FUNR,        {Function Result}
  15.                 LG_OBJP,        {Parent Object}
  16.                 LG_PARM,        {Formal Parameter}
  17.                 LG_TYPE            {Named Type, Xtrn Var}
  18.                 );
  19.    LGString    = String[21];
  20.  
  21. VAR
  22.    CSegOrg,    CSegEnd,     NextLL,    LastLL        : Word;
  23.    TabStop,    NoteX,         NoteY                    : Integer;
  24.    NoteTime, JobTime     : LongInt;    CPUType: CPUGate;
  25.    DisAssembly    : Boolean;
  26.    SurveyWork   : SurveyRec;
  27.    Map          : MapRefRec;
  28.  
  29. CONST
  30.    TypTxt : Array[0..15] of String[11] = (
  31.        { $0} 'untyped', { $1} 'ARRAY', { $2} 'RECORD',    { $3} 'OBJECT',
  32.         { $4} 'FILE',     { $5} 'TEXT',  { $6} 'proc',    { $7} 'SET',
  33.         { $8} 'POINTER', { $9} 'STRING',{ $A} '8087 float',
  34.     { $B} '6-byte real',        { $C} 'fixed-point',
  35.     { $D} 'boolean', { $E} 'char',    { $F} 'enumeration');
  36.  
  37. PROCEDURE NoteBegin(S:String);                                  {.CP08}
  38. VAR HH,MM,SS,CS : Word;
  39. BEGIN
  40.     NoteX := WhereX; NoteY := WhereY; ClrEol;
  41.     GetTime(HH,MM,SS,CS);
  42.     NoteTime := (LongInt(HH*60+MM)*60+SS)*100+CS;
  43.     If S <> '' Then Write(S);
  44. END;
  45.  
  46. PROCEDURE PageOverFlow(Lines : Word; CallProc : HeadProc);      {.CP09}
  47. BEGIN
  48.     IF LinesRemaining < Lines THEN
  49.     BEGIN
  50.         NewTxtPage;
  51.         CallProc;
  52.     END
  53.     ELSE    NewTxtLine;
  54. END;
  55.  
  56. PROCEDURE NoteEnd;                        {.CP11}
  57. VAR HH,MM,SS,CS : Word; SF : String[3];  I : Integer;
  58. BEGIN
  59.     GetTime(HH,MM,SS,CS);
  60.     NoteTime := ((LongInt(HH*60+MM)*60+SS)*100+CS) - NoteTime;
  61.         Str(NoteTime MOD 100 + 100:3,SF);
  62.         I := NoteTime DIV 100;
  63.     Write(', Finished in ',I,'.',Copy(SF,2,2),' seconds');
  64.     Delay(1000);
  65.     GoToXY(NoteX,NoteY);
  66. END;
  67.  
  68. FUNCTION NameOfMethod(U:UnitPtr;UsrDE:LL):MethodName;            {.CP20}
  69. VAR DS, DC : DNamePtr; S : DStubPtr; T : TypePtr; N, M : String[64];
  70. BEGIN
  71.     N := ''; M := '???';
  72.     IF UsrDE <> $FFFF THEN
  73.     BEGIN
  74.         DS := DNamePtr(PtrAdjust(U,UsrDE));
  75.         M  := DS^.DSymb;
  76.         S  := AddrStub(DS);
  77.         IF Public(DS^.DForm) = 'S' THEN   {ensure subprogram entry}
  78.         IF (S^.sSTp AND $10) <> 0 THEN {get OBJECT Name Qualifier}
  79.         IF  S^.sSPS <> 0 THEN
  80.         BEGIN
  81.             T  := TypePtr(PtrAdjust(U,S^.sSPS));    {to Object TD}
  82.             DC := DNamePtr(PtrAdjust(U,T^.ObjtName)); {to Object DE}
  83.             N  := DC^.Dsymb+'.';
  84.         END
  85.     END;
  86.     NameOfMethod := N + M
  87. END;   {NameOfMethod}
  88.  
  89. PROCEDURE PrintTitleBlk(S : String; LinesNeeded : Integer);    {.CP11}
  90. BEGIN {PrintTitleBlk}
  91.     IF LinesRemaining < LinesNeeded+3
  92.         THEN NewTxtPage    ELSE SetCol(1);
  93.     PutTxt('----');
  94.     NewTxtLine;
  95.     PutTxt('- ' + S);
  96.     NewTxtLine;
  97.     PutTxt('----');
  98.     SetCol(1);
  99. END; {PrintTitleBlk}
  100.  
  101. PROCEDURE PrintAddress(Arg : LL);                {.CP06}
  102. BEGIN
  103.     IF ColumnsUsed <> 0 THEN NewTxtLine;
  104.     PutTxt(HexW(Arg));
  105.     SetCol(7);
  106. END; {PrintAddress}
  107.  
  108. PROCEDURE PrintByteList(U : UnitPtr; Count, Space : Word);    {.CP11}
  109. BEGIN
  110.     WITH BufPtr(U)^ DO
  111.     WHILE Count > 0 DO
  112.     BEGIN
  113.         PutTxt(HexB(BufByt[NextLL]));
  114.         SetCol(ColumnsUsed+Space+1);
  115.         Inc(NextLL);
  116.         Dec(Count);
  117.     END
  118. END; {PrintByteList}
  119.  
  120. PROCEDURE PrintWd(U : UnitPtr; S : String);            {.CP07}
  121. BEGIN
  122.     PrintAddress(NextLL);
  123.     PrintByteList(U,2,1);
  124.     SetCol(TabStop);
  125.     PutTxt(S);
  126. END; {PrintWd}
  127.  
  128. PROCEDURE PrintDWd(U : UnitPtr; S : String);            {.CP07}
  129. BEGIN
  130.     PrintAddress(NextLL);
  131.     PrintByteList(U,4,1);
  132.     SetCol(TabStop);
  133.     PutTxt(S);
  134. END; {PrintDWd}
  135.  
  136. PROCEDURE PrintLL(U : UnitPtr; S : String);            {.CP07}
  137. BEGIN
  138.     PrintAddress(NextLL);
  139.     PrintByteList(U,2,1);
  140.     SetCol(TabStop);
  141.     PutTxt('LL('+S+')');
  142. END; {PrintLL}
  143.  
  144. PROCEDURE PrintSoloByte(U : UnitPtr; S : String);        {.CP08}
  145. VAR B : Byte;
  146. BEGIN
  147.     PrintAddress(NextLL);
  148.     PrintByteList(U,1,0);
  149.     SetCol(TabStop);
  150.     PutTxt(S);
  151. END; {PrintSoloByte}
  152.  
  153. PROCEDURE PrintBytes(U : UnitPtr; Count, Limit : Word);            {.CP12}
  154. VAR I : Integer;
  155. BEGIN
  156.     I := 0;
  157.     WITH BufPtr(U)^ DO WHILE Count > 0 DO BEGIN
  158.         I := I MOD Limit;
  159.         IF I = 0 THEN PrintAddress(NextLL);
  160.         PrintByteList(U,1,1);
  161.         Inc(I);
  162.         Dec(Count);
  163.     END;
  164. END; {PrintBytes}
  165.  
  166. FUNCTION NilLG(L: LG) : Boolean;                        {.CP02}
  167. BEGIN NilLG := (L.UntLL = 0) AND (L.UntId = 0) END;
  168.  
  169. Function GetArrayBounds(U: UnitPtr; Arg: LG):String;        {.CP14}
  170. Var Tp: TypePtr; V: DNamePtr; Tu: UnitPtr; R: RespLG; Bl,Bu: String[12];
  171. Begin
  172.    GetArrayBounds := '';
  173.    V := AddrLGUnit(U,Arg);        {Point to Host Unit Name}
  174.    ResolveLG(V^.DSymb,Arg,R);        {Find Unit in Heap}
  175.    Tu := R.Uptr;                        {Get Ptr to Host Unit}
  176.    If Tu <> Nil Then
  177.    Begin
  178.       Tp := TypePtr(PtrAdjust(Tu,Arg.UntLL)); {to bounds descriptor}
  179.       Str(Tp^.LoBnd, Bl); Str(Tp^.HiBnd, Bu);
  180.       GetArrayBounds := Bl + '..' + Bu;
  181.    End;
  182. End; {GetArrayBounds}
  183.  
  184. PROCEDURE PrintLG(U : UnitPtr; LGS: LGClass; S : String);    {.CP34}
  185. CONST
  186.    LG_Txt : Array[LGClass] Of LGString =
  187.           ({LG_ABSQ} 'ABSOLUTE Target-Stub',
  188.         {LG_ARBC} 'Array[',        {LG_ASGN} 'Assgn Cmpat Type',
  189.         {LG_BASE} 'Base Type',    {LG_CONS} 'CONST Cmpat Type',
  190.         {LG_FUNR} 'Return Result',    {LG_OBJP} 'Ancestor Object',
  191.         {LG_PARM} 'Parm ',        {LG_TYPE} 'Named Type');
  192.  
  193. VAR L: LG; V : DNamePtr; R: RespLG; X: _UnitName; W : String;
  194. BEGIN
  195.         L := LG(Ptr(Seg(U^),Ofs(U^)+NextLL)^);
  196.     IF NOT NilLG(L) THEN
  197.     BEGIN
  198.              V := AddrLGUnit(U,L);        {point to Unit Entry}
  199.          X := '';                {its name}
  200.              R.Ownr := $FFFF;
  201.              If V <> Nil Then
  202.          Begin
  203.             X := V^.DSymb;
  204.         ResolveLG(X,L,R)
  205.              End;
  206.              If (R.Ownr <> $FFFF) AND (R.Ownr <> 0) Then
  207.          Begin
  208.              W := X + '.' + NameOfMethod(R.Uptr,R.Ownr);
  209.                 If LGS <> LG_PARM Then S := '' End
  210.              Else  W := 'in [' + X + '] ';
  211.          W := 'LG(' + W + ') ' + LG_Txt[LGS];
  212.              If LGS = LG_ARBC
  213.          Then W := W + GetArrayBounds(U,L) +']'
  214.          Else W := W + S;
  215.              S := W;
  216.     END Else S := 'LG(nil type) ' + S;
  217.     PrintAddress(NextLL);
  218.     PrintByteList(U,4,1);
  219.     SetCol(TabStop);
  220.     PutTxt(S);
  221. END; {PrintLG}
  222.  
  223. PROCEDURE BoundaryAlign(UH : UnitPtr);                    {.CP12}
  224. VAR I : Integer;
  225. BEGIN {BoundaryAlign}
  226.     I := ((NextLL + 15) AND $FFF0) - NextLL;
  227.     IF I > 0 THEN
  228.     BEGIN
  229.         PrintBytes(UH,I,8);
  230.         SetCol(36);
  231.         PutTxt('Align to Paragraph Boundary');
  232.         NewTxtLine
  233.     END;
  234. END;  {BoundaryAlign}
  235.  
  236. PROCEDURE PrintOffset(Base: Word);                {.CP06}
  237. BEGIN
  238.      IF ColumnsUsed <> 0 THEN NewTxtLine;
  239.      PutTxt(HexW(NextLL));SetCol(6);
  240.      PutTxt('[+'+HexW(NextLL-Base)+'] ');
  241. END;
  242.  
  243. PROCEDURE PrintCodeBytes(U : UnitPtr; Count,Limit,Base: Word;X : Boolean); {.CP34}
  244. CONST Xlat : SET OF Char = [' '..Chr($7E)];
  245. VAR I : Integer; j,k : Word; S : String;  C : ^Char;
  246. BEGIN
  247.     I := 0; j := 0; k := Limit*3 + 17; S := '';
  248.     WITH BufPtr(U)^ DO WHILE Count > 0 DO BEGIN
  249.         I := I MOD Limit;
  250.         IF I = 0 THEN
  251.         BEGIN
  252.             IF X THEN
  253.             BEGIN
  254.                 SetCol(K);
  255.                 PutTxt(S);
  256.                 S := '';
  257.             END;
  258.             PrintOffset(Base);
  259.         END;
  260.         IF X THEN
  261.         BEGIN
  262.             C :=Ptr(Seg(U^),Ofs(U^)+NextLL);
  263.             IF C^ IN Xlat THEN S := S + C^
  264.                       ELSE S := S + '.'
  265.         END;
  266.         PrintByteList(U,1,1);
  267.         Inc(I);
  268.         Dec(Count);
  269.     END;
  270.     IF X THEN
  271.     BEGIN
  272.         SetCol(K);
  273.         PutTxt(S);
  274.         S := '';
  275.     END;
  276. END; {PrintCodeBytes}
  277.  
  278. PROCEDURE PrintUnknowns(U : UnitPtr; Till:LL);                {.CP06}
  279. BEGIN {PrintUnknowns}
  280.     PrintTitleBlk('The Purpose of the data below is Unknown',1);
  281.     PrintBytes(U,Till-NextLL,8);
  282.     NewTxtLine;
  283. END;  {PrintUnknowns}
  284.  
  285. PROCEDURE FormatHeader(U : UnitPtr);                    {.CP38}
  286. VAR I : Integer;
  287. BEGIN
  288.     NoteBegin('Formatting Unit Header');
  289.     PrintAddress(NextLL);
  290.     FOR I := 0 TO 3 DO PutTxt(HexB(Byte(U^.UHEYE[I]))+' ');
  291.     SetCol(TabStop);
  292.     PutTxt('=''');
  293.     FOR I := 0 TO 3 DO PutTxt(U^.UHEYE[I]);
  294.     PutTxt('''');
  295.     NewTxtLine;
  296.     Inc(NextLL,4);
  297.     PrintAddress(NextLL);
  298.     FOR I := 0 TO 3 DO PutTxt(HexB(Byte(U^.UHxxx[I]))+' ');
  299.     NewTxtLine;
  300.     Inc(NextLL,4);
  301.     PrintLL(U,'Dict Hdr-This Unit');
  302.     PrintLL(U,'INTERFACE Hash Table');
  303.     PrintLL(U,'PROC Map');
  304.     PrintLL(U,'CSEG Map');
  305.     PrintLL(U,'DSEG Map-Typed CONST''s');
  306.     PrintLL(U,'DSEG Map-Global VARs');
  307.     PrintWd(U,'Usage Unknown');
  308.     PrintLL(U,'Donor Unit List');
  309.     PrintLL(U,'Source File List');
  310.         With U^ Do If UHDBT = UHENC
  311.         Then PrintWd(U,'No Trace Table')
  312.     Else PrintLL(U,'Debug TRACE Table');
  313.     PrintLL(U,'end NON-CODE part of Unit');
  314.     PrintWd(U,'CSEG Size (Aggregate)');
  315.     PrintWd(U,'DSEG Size (Typed CONST''s)');
  316.     PrintWd(U,'Fix-Up List Size (CSegs)');
  317.     PrintWd(U,'Fix-Up List Size (Typed CONST''s)');
  318.     PrintWd(U,'DSEG Size (Global VARs)');
  319.     PrintLL(U,'DEBUG Hash Table');
  320.         If U^.UHSOV = 0
  321.         Then PrintWd(U,'No Overlay')
  322.         Else PrintWd(U,'Overlay Involved');
  323.     NewTxtLine;
  324.     IF NextLL < U^.UHIHT THEN PrintUnknowns(U,U^.UHIHT);
  325.     NoteEnd;
  326. END; {FormatHeader}
  327.  
  328. PROCEDURE FormatDictionary(U : UnitPtr);            {.CP19}
  329.  
  330.    PROCEDURE PrintDictEntry;
  331.    VAR D, DB: DNamePtr; S: DStubPtr; I: Integer; It: Byte;
  332.        RP: VarStubPtr; DF: Char; DFM: String[8];
  333.        T : String[44]; W : String;
  334.    BEGIN {PrintDictEntry}
  335.       D := AddrDict(U,SurveyWork.LocLL); S := AddrStub(D);
  336.       RP := @S^.sRVF;
  337.       WITH SurveyWork, D^, S^ DO
  338.       BEGIN
  339.          DF := Public(DForm);
  340.          IF DF <> DForm Then DFM := 'Private ' Else DFM := '';
  341.          I := 4+(Length(DSymb) SHR 4);
  342.      CASE DF OF 'R','Y': Inc(I,4);
  343.                         'S': Inc(I,6);
  344.                     'P': Inc(I,2);
  345.            'Q','O','T'..'X': Inc(I);
  346.      END; {CASE}
  347.      W := '';                                {.CP12}
  348.      IF DF = 'R' THEN
  349.               Case sRAM Of
  350.           $08: IF SurveyWork.LocOwn <> 0
  351.                THEN W := NameOfMethod(U,SurveyWork.LocOwn);
  352.                   $10,$01,$00: ;
  353.           ELSE IF RP^.ROB <> 0 THEN W := NameOfMethod(U,RP^.ROB);
  354.               End; {Case}
  355.      IF W = '???' THEN W := '' ELSE
  356.      IF W <> ''   THEN W := W + '.';
  357.      PrintTitleBlk('Dictionary Entry For: "'+ W +
  358.      NameOfMethod(U,SurveyWork.LocLL)+'"',I);
  359.      IF HLink <> 0                                          {.CP06}
  360.         THEN PrintLL(U,AddrDict(U,HLink)^.DSymb)
  361.         ELSE PrintWd(U,'(no backward link)');
  362.      PrintBytes(U,1,1);
  363.      SetCol(TabStop);
  364.      PutTxt(DFM+'Type "'+DF+'" -> ');
  365.      CASE DF OF                                             {.CP18}
  366.        'O': PutTxt('GOTO Label');  'P': PutTxt('Un-Typed CONST');
  367.        'Y': PutTxt('Unit');        'T': PutTxt('Built-In Procedure');
  368.        'W': PutTxt('Port Array');  'U': PutTxt('Built-In Function');
  369.        'Q': PutTxt('Named Type');  'V': PutTxt('Built-In "NEW"');
  370.        'X': PutTxt('MEM_ Array');
  371.        'R': CASE sRAM OF
  372.               $00: PutTxt('Global VAR');
  373.           $01: PutTxt('Typed CONST');
  374.           $02: PutTxt('Local VAR (on Stack)');
  375.                   $03: PutTxt('Absolute VAR [Seg:Ofs]');
  376.           $06: PutTxt('Self VAR (ADDR on Stack)');
  377.           $08: PutTxt('Record/Object Field');
  378.                   $10: PutTxt('Absolute VAR (Equated)');
  379.                   $22: PutTxt('VALUE Arg on Stack');
  380.                   $26: PutTxt('VAR Arg on Stack');
  381.                   Else PutTxt('New Data Type');
  382.             END; {CASE sRAM}
  383.        'S': IF sSVM = 0 Then                                {.CP12}
  384.                    Case (sSTp AND $70) Of
  385.                      $10: PutTxt('Method');
  386.                      $30: PutTxt('Constructor');
  387.                      $50: PutTxt('Destructor');
  388.                      Else PutTxt('Subprogram')
  389.                    End
  390.                 Else PutTxt('Virtual Method');
  391.      END; {CASE DF OF}
  392.      PrintBytes(U,Length(DSymb)+1,16);
  393.      SetCol(TabStop); PutTxt('="'+DSymb+'"');
  394.      NewTxtLine;
  395.      CASE DF OF { Format the Stub Part }                    {.CP13}
  396.        'O': PrintWd(U,'Unknown purpose)');
  397.        'P': BEGIN
  398.            PrintLG(U,LG_CONS,'');
  399.            PrintBytes(U,LastLL-NextLL,8); {Temporary Fix}
  400.            {since value can be a string, we really need to check
  401.             the type descriptor out but that usually lies in the
  402.             system unit.  We circumvent for now by relying on the
  403.             distance to the next structure to determine the size
  404.             of the constant data for print purposes }
  405.            SetCol(TabStop); PutTxt('Constant Value');
  406.            NewTxtLine;
  407.             END; {CASE 'P'}
  408.        'Y': BEGIN                                           {.CP07}
  409.                    PrintWd(U,'TURBO Work?');
  410.            PrintWd(U,'Unit Version Number???');
  411.            PrintLL(U,'next unit in list');
  412.            PrintLL(U,'prior unit in list');
  413.            NewTxtLine;
  414.             END; {CASE 'Y'}
  415.        'T','U','V': BEGIN                                   {.CP04}
  416.                        PrintWd(U,'Meaning Unknown');
  417.                NewTxtLine;
  418.                     END;
  419.        'W': BEGIN                                           {.CP04}
  420.            PrintSoloByte(U,'0=byte array, 1=word array');
  421.            NewTxtLine;
  422.             END;
  423.        'Q','X': BEGIN                                       {.CP04}
  424.                    PrintLG(U,LG_TYPE,'');
  425.                NewTxtLine;
  426.                 END;
  427.        'R': BEGIN                                           {.CP49}
  428.                    It := sRAM AND $1F;
  429.            CASE sRAM OF
  430.                       $00: T := 'Global VAR in DS';
  431.                       $01: T := 'Typed CONST in DS';
  432.                       $02: IF RP^.ROfs > $7FFF
  433.                  THEN T := 'Local VAR on Stack'
  434.                              ELSE T := 'VALUE(Stack)';
  435.                       $03: T := 'Absolute [Seg:Ofs]';
  436.                       $06: T := 'ADDR(Self) on Stack';
  437.                       $08: T := 'Record/Object Field';
  438.                       $10: T := 'Absolute Equivalence';
  439.                       $22: T := 'Arg On Stack (VALUE)';
  440.                       $26: T := 'Arg On Stack (VAR)';
  441.                       ELSE T := '**** NEW CODE TO CHECK ****'
  442.            END; {CASE sRAM}
  443.            PrintSoloByte(U,T);
  444.            T := '';
  445.                    Case It Of
  446.                      $03: Begin
  447.                              PrintWd(U,'Absolute Offset');
  448.                              PrintWd(U,'Absolute Segment');
  449.                           End;
  450.                      $10: PrintLG(U,LG_ABSQ,'');
  451.                      Else
  452.                      Begin
  453.             IF (It = $2) OR (It = $6) THEN With RP^ DO
  454.             IF RP^.ROfs > $7FFF
  455.                THEN T := 'BP-'+HexW($10000-ROfs)
  456.                ELSE T := 'BP+'+HexW(ROfs)
  457.             ELSE T := 'bytes';
  458.             PrintWd(U,'allocation offset ('+T+')');
  459.             CASE It OF
  460.                           $0: T := 'Entry offset in VAR DSeg Map';
  461.                           $1: T := 'Entry offset in CON DSeg Map';
  462.                           $2,$6:
  463.                                 IF RP^.ROB = 0
  464.                 THEN T := 'no containing scope'
  465.                 ELSE T := 'LL(containing Scope)';
  466.               $8: IF RP^.ROB = 0
  467.                               THEN T := 'no successor field/method'
  468.                               ELSE T := 'LL(successor field/method)';
  469.               ELSE T := 'Usage Unknown'
  470.             END; {CASE It}
  471.             PrintWd(U,T);
  472.                      End {Case It}
  473.                    End; {Case sRAM}
  474.            PrintLG(U,LG_BASE,'');
  475.             END; {CASE 'R'}
  476.        'S': BEGIN                                           {.CP37}
  477.            T := '';
  478.            IF ((sSTp AND $01) = 0) AND ((sSTp AND $16) = 0)
  479.                    THEN T := '+NEAR'
  480.                    ELSE IF  (sSTp AND $10) <> 0 THEN
  481.                     CASE (sSTp AND $60) OF
  482.                   $00: T := '+Method';
  483.                               $20: T := '+Constructor';
  484.                   $40: T := '+Destructor';
  485.                   ELSE T := '+Method?'
  486.                     END;
  487.            IF (sSTp AND $08) <> 0 THEN T := T + '+EXTERNAL';
  488.            IF (sSTp AND $01) <> 0 THEN T := T + '+FAR';
  489.            IF (sSTp AND $02) <> 0 THEN T := T + '+INLINE';
  490.                    IF (sSTp AND $04) <> 0 THEN T := T + '+INTERRUPT';
  491.                    IF (sSTp AND $80) <> 0 THEN T := T + '+ASSEMBLER';
  492.            IF Length(T) > 0 THEN Delete(T,1,1);
  493.            PrintSoloByte(U,T);
  494.                    PrintSoloByte(U,'Usage Unknown');
  495.            IF (sSTp AND $02) <> 0  THEN T := 'INLINE Code Bytes'
  496.                                ELSE T := 'offset in PROC Map';
  497.            PrintWd(U,T);
  498.            IF sSPS = 0 THEN T := 'no containing scope'
  499.                    ELSE T := 'LL(containing scope)';
  500.            PrintWd(U,T);
  501.            IF sSHT = 0 THEN T := 'no local Hash Table'
  502.                    ELSE T := 'LL(local scope Hash Table)';
  503.            PrintWd(U,T);
  504.                    IF sSVM = 0
  505.                    THEN PrintWd(U,'Not Used')
  506.                    ELSE PrintWd(U,'Method Ptr Offset in VMT');
  507.                    SetCol(1);
  508.             END; {CASE 'S'}
  509.      END; {CASE DF OF}
  510.       END; {WITH}
  511.  
  512.    END;  {PrintDictEntry}
  513.  
  514.    PROCEDURE PrintTypeEntry;                    {.CP51}
  515.    VAR T : TypePtr; W : String[64]; D : DNamePtr; I : Integer;
  516.  
  517.    BEGIN {PrintTypeEntry}
  518.       T := TypePtr(PtrAdjust(U,SurveyWork.LocLL)); I := 0;
  519.       CASE T^.tpTC OF
  520.         $01, $02, $09: I := 2; $04, $05, $07, $08: I := 1;
  521.              $0C..$0F: I := 3; $03: I := 10;  $06: I := 7 + 2*T^.PNPrm;
  522.       END; {CASE}
  523.       W := '';
  524.       IF SurveyWork.LocOwn <> 0
  525.       THEN W := NameOfMethod(U,SurveyWork.LocOwn) ELSE
  526.       IF T^.tpTC = $03 THEN W := NameOfMethod(U,T^.ObjtName);
  527.       IF (W <> '') AND (W <> '???') THEN W := ' For: "' + W + '"';
  528.       PrintTitleBlk('Type Descriptor' + W,I+2);
  529.       WITH T^ DO BEGIN
  530.          PrintBytes(U,2,8);SetCol(TabStop);
  531.          CASE tpTC OF
  532.            $00: W := 'un-typed';  $01: W := 'Array';
  533.            $02: W := 'Record';    $03: W := 'Object';
  534.            $04: W := 'File';      $05: W := 'Text';
  535.            $06: If NilLG(PFRes)
  536.         Then W := 'Procedure'
  537.         Else W := 'Function';
  538.            $07: W := 'Set';
  539.            $08: W := 'Pointer';   $09: W := 'String';
  540.            $0A: CASE tpTQ OF
  541.                   $00: W := 'Single'; $02: W := 'Extended';
  542.           $04: W := 'Double'; $06: W := 'Comp';
  543.           ELSE W := '8087-Floating?'
  544.             END; {CASE tpTQ}
  545.            $0B: W := 'Real';
  546.            $0C: CASE tpTQ OF
  547.           $00: W := 'un-named byte integer';  $01: W := 'ShortInt';
  548.                   $02: W := 'Byte';      $04: W := 'un-named word integer';
  549.                   $05: W := 'Integer';   $06: W := 'Word';
  550.                   $0C: W := 'un-named DWORD integer';
  551.                   $0D: W := 'LongInt';
  552.                   ELSE W := 'unknown integer type';
  553.                 END; {CASE tpTQ}
  554.            $0D: W := 'Boolean';     $0E: W := 'Char';
  555.            $0F: W := 'enumeration';
  556.            ELSE W := 'unknown type code';
  557.          END; {CASE tpTC OF}
  558.          PutTxt('Type='+W);
  559.          PrintWd(U,'Storage Width (bytes)');
  560.          If tpML = 0
  561.            Then If tpTC = $06
  562.                 Then PrintWd(U,'NO Next Method')
  563.                 Else PrintWd(U,'Usage Unknown')
  564.            Else PrintLL(U,'Dict Hdr, Next Method');
  565.          CASE tpTC OF                        {.CP05}
  566.            $01: BEGIN
  567.            PrintLG(U,LG_BASE,'');
  568.            PrintLG(U,LG_ARBC,'');
  569.         END;
  570.        $02: BEGIN                        {.CP04}
  571.            PrintLL(U,'Field List Hash Table');
  572.            PrintLL(U,'Dict Entry of 1st Field');
  573.         END;
  574.        $03: BEGIN                        {.CP19}
  575.            PrintLL(U,'Field/Method Hash Table');
  576.            PrintLL(U,'Field/Method Dictionary');
  577.            IF NilLG(ObjtOwnr)
  578.             THEN PrintDWd(U,'nothing inherited')
  579.             ELSE PrintLG(U,LG_OBJP,'');
  580.            PrintWd(U,'Size of VMT (bytes)');
  581.            IF ObjtDMap = $FFFF
  582.             THEN PrintWd(U,'there is no VMT')
  583.             ELSE PrintWd(U,'DSeg Map Offset of VMT Template');
  584.            IF ObjtVMTO = $FFFF
  585.             THEN PrintWd(U,'Object has no VIRTUAL Methods')
  586.             ELSE PrintWd(U,'Offset in Object to VMT Pointer');
  587.            D := AddrDict(U,ObjtName);
  588.            PrintLL(U,'Dict Entry ('+D^.DSymb+')');
  589.                    PrintBytes(U,8,8);
  590.                    SetCol(TabStop);
  591.                    PutTxt('Usage Unknown');
  592.         END;
  593.        $06: BEGIN                        {.CP21}
  594.               IF NilLG(PFRes)
  595.            THEN PrintDWd(U,'Procedures have no Result')
  596.            ELSE PrintLG(U,LG_FUNR,'');
  597.            IF PNPrm = 0 THEN PrintWd(U,'no parameter list') ELSE
  598.            BEGIN
  599.               Str(PNPrm,W); W := W + ' Formal Parameter';
  600.               IF PNPrm > 1 THEN W := W + 's';
  601.               PrintWd(U,W);
  602.               FOR I := 1 TO PNPrm DO WITH PFPar[I] DO BEGIN
  603.             Str(I,W);
  604.             PrintLG(U,LG_PARM,W);
  605.             IF fPAM = $02
  606.             THEN W := 'Pass VALUE on Stack'
  607.             ELSE IF fPAM = $06
  608.                 THEN W := 'Pass ADDRESS on Stack'
  609.                 ELSE W := '**** NEW CODE VALUE ***';
  610.             PrintSoloByte(U,W)
  611.               END; {FOR}
  612.            END;
  613.         END;  { CASE $06 }
  614.        $04: PrintLG(U,LG_BASE,' FILE');            {.CP08}
  615.        $05: PrintLG(U,LG_BASE,' TEXT');
  616.        $07: PrintLG(U,LG_BASE,' SET');
  617.        $08: PrintLG(U,LG_BASE,' POINTER');
  618.        $09: BEGIN
  619.            PrintLG(U,LG_BASE,'STRING');
  620.            PrintLG(U,LG_ARBC,'');
  621.         END;
  622.        $0C..                        {.CP12}
  623.        $0F: BEGIN
  624.               PrintBytes(U,SizeOf(T^.LoBnd),8);
  625.            SetCol(TabStop);PutTxt('Subrange Lower Bound');
  626.            PrintBytes(U,SizeOf(T^.HiBnd),8);
  627.            SetCol(TabStop);PutTxt('Subrange Upper Bound');
  628.            PrintLG(U,LG_ASGN,'');
  629.            END; { $0C,$0D,$0E,$0F}
  630.      END; {CASE tpTC OF}
  631.       END; {WITH}
  632.  
  633.    END;  {PrintTypeEntry}
  634.  
  635.    PROCEDURE PrintHashEntry;                    {.CP22}
  636.    VAR H : HashPtr;
  637.  
  638.     FUNCTION PrintEmptyHash(Bot,Top:Word):Word;
  639.     VAR  I, J, K : Word;
  640.     BEGIN
  641.        I := Bot;
  642.        WITH H^ DO REPEAT
  643.            IF Slt[I] = 0
  644.         THEN Inc(I)
  645.         ELSE Top := I-1;
  646.        UNTIL Top < I;
  647.        K := 0;
  648.        WITH H^ DO FOR J := Bot TO Top DO BEGIN
  649.           IF (K AND $3)=0 THEN PrintAddress(NextLL);
  650.           PutTxt(HexB(LO(Slt[J]))+' ');
  651.           PutTxt(HexB(HI(Slt[J]))+' ');
  652.           Inc(NextLL,2);
  653.           Inc(K);
  654.        END;
  655.        PrintEmptyHash := I
  656.     END; {PrintEmptyHash}
  657.  
  658.    VAR  D : DNamePtr; I, J, K, N : Word; W : String[44];    {.CP26}
  659.  
  660.    BEGIN {PrintHashEntry}
  661.        H := AddrHash(U,SurveyWork.LocLL);
  662.     N := H^.Bas DIV 2;
  663.     W := '';
  664.     IF SurveyWork.LocLL = U^.UHIHT
  665.     THEN W := '- INTERFACE Dictionary'    ELSE
  666.     IF SurveyWork.LocLL = U^.UHDHT
  667.     THEN W := '- Turbo DEBUG Dictionary'    ELSE
  668.     IF SurveyWork.LocOwn <> 0
  669.     THEN W := 'Owned By: "'+NameOfMethod(U,SurveyWork.LocOwn)+'"';
  670.     PrintTitleBlk('Hash Table '+W,3);
  671.     PrintWd(U,'Bytes in Hash Table - 2');
  672.     SetCol(1);PutTxt('----');
  673.     I := 0;
  674.  
  675.     WITH H^ DO REPEAT
  676.        IF Slt[I] <> 0 THEN
  677.        BEGIN
  678.           PrintLL(U,AddrDict(U,Slt[I])^.DSymb);
  679.           Inc(I)
  680.        END ELSE I := PrintEmptyHash(I,N);
  681.     UNTIL I > N;
  682.     NewTxtLine;
  683.    END;  {PrintHashEntry}
  684.  
  685.    PROCEDURE PrintInLineEntry;                    {.CP15}
  686.    VAR D : DNamePtr; S : DStubPtr; I : Integer;  T : TypePtr;
  687.  
  688.    BEGIN {PrintInLineEntry}
  689.       D := AddrDict(U,SurveyWork.LocOwn);   { Procedure  Header }
  690.       S := AddrStub(D);                     { Procedure  Stub   }
  691.       T := AddrProcType(S);                 { Type Descriptor   }
  692.       WITH SurveyWork, T^ DO BEGIN
  693.      I := (S^.sSPM+15) SHR 4;
  694.      PrintTitleBlk('INLINE Code Bytes FOR: "'+
  695.              NameOfMethod(U,SurveyWork.LocOwn)+'"',I);
  696.      PrintBytes(U,S^.sSPM,16);
  697.      SetCol(1);
  698.       END;
  699.    END;  {PrintInLineEntry}
  700.  
  701. VAR I : Word; BU : SurveyRec; DoneDict,DoneHash : Boolean; BUL : LL;  {.CP30}
  702. BEGIN {FormatDictionary}
  703.     NoteBegin('Formatting Dictionary');
  704.     DoneHash := False; DoneDict := False;
  705.         FetchSurveyRec(SurveyWork);
  706.     WITH SurveyWork DO
  707.     While LocTyp <> cvNULL DO BEGIN
  708.                 LastLL := LocNxt;
  709.         BU := SurveyWork;
  710.         IF NextLL < LocLL THEN
  711.         IF NOT DoneHash THEN PrintUnknowns(U,LocLL) ELSE
  712.                 IF DoneDict     THEN PrintUnknowns(U,LocLL) ELSE
  713.         BEGIN
  714.             BUL := LastLL;
  715.             LocLL := NextLL; LastLL := BU.LocLL;
  716.             LocOwn := 0; LocTyp := cvType;
  717.             PrintTypeEntry;
  718.             SurveyWork := BU; LastLL := BUL;
  719.         END;
  720.         CASE LocTyp OF
  721.              cvName: BEGIN PrintDictEntry; DoneDict := True END;
  722.              cvType: PrintTypeEntry;
  723.              cvHash: BEGIN PrintHashEntry; DoneHash := True END;
  724.              cvINLN: PrintInLineEntry;
  725.         END; {CASE}
  726.                 FetchSurveyRec(SurveyWork);
  727.     END;   {While}
  728.     IF NextLL < U^.UHPMT THEN PrintUnknowns(U,U^.UHPMT);
  729.     NoteEnd;
  730. END;  {FormatDictionary}
  731.  
  732. FUNCTION NameOfObject(U:UnitPtr;UsrDE:LL):_LexName;        {.CP15}
  733. VAR D : DNamePtr; T : TypePtr;
  734. BEGIN
  735.    NameOfObject := '???';
  736.    IF UsrDE <> $0000 THEN
  737.    BEGIN
  738.     T  := TypePtr(PtrAdjust(U,UsrDE));    {to Object TD}
  739.     D  := Nil;
  740.     IF T^.tpTC = $03 THEN
  741.     BEGIN
  742.        D  := DNamePtr(PtrAdjust(U,T^.ObjtName)); {to Object DE}
  743.        NameOfObject := D^.Dsymb
  744.     END
  745.    END
  746. END;  {NameOfObject}
  747.  
  748. PROCEDURE CSegHeadings; Far;                    {.CP45}
  749. BEGIN
  750.    SetCol(7);
  751.    PutTxt('Entry  Turbo Segmt FixUp Trace : Source File   Load [Fix-Ups]');
  752.    SetCol(7);
  753.    PutTxt('Offset Work? Bytes Bytes Entry : For CODE Seg  ADDR 1''st last');
  754.    SetCol(7);
  755.    PutTxt('------ ----- ----- ----- ----- : ------------  ---- ---- ----');
  756. END; {CSegHeadings}
  757.  
  758. PROCEDURE FormatCSegMap(UPt:UnitPtr);                {.CP35}
  759.  
  760. VAR    C : CMapTabPtr; SF : SrcFilePtr;
  761.     OldTabSet, Base, Cx, NMapC : Word;
  762. BEGIN
  763.     NoteBegin('Formatting CSeg Map');
  764.     OldTabSet := TabStop;
  765.     TabStop := 40;
  766.         NMapC := Upt^.UHTMT-Upt^.UHCMT; Cx := 0;
  767.  
  768.     IF NMapC > 0 THEN    { make sure CSeg Map non-empty }
  769.     BEGIN
  770.         PrintTitleBlk('CSeg Map Table',7);
  771.         NextLL := Upt^.UHCMT;
  772.         CSegHeadings;  Base := NextLL;
  773.         REPEAT
  774.             PageOverFlow(6,CSegHeadings);
  775.                         FetchMapRef(Map,rCSEG,Cx);
  776.             SF := AddrSrcTabOff(UPt,Map.MapSrc);
  777.             PrintCodeBytes(UPt,8,8,Base,False);
  778.             SetCol(TabStop);
  779.             PutTxt(SF^.SrcName);
  780.             SetCol(TabStop+14);
  781.             PutTxt(HexW(Map.MapLod)+' ');
  782.             IF Map.MapFxJ <> 0 THEN
  783.             BEGIN
  784.                 PutTxt(HexW(Map.MapFxI)+' ');
  785.                 PutTxt(HexW(Map.MapFxJ));
  786.             END;
  787.             Inc(Cx,SizeOf(CMapRec));
  788.         UNTIL Cx > NMapC-1;
  789.     END;
  790.     TabStop := OldTabSet;
  791.     NoteEnd;
  792. END;  { FormatCSegMap }
  793.  
  794. PROCEDURE ProcHeadings; Far;                                    {.CP38}
  795. BEGIN
  796.   SetCol(7); PutTxt('Entry  Turbo Turbo CSeg  PROC  : Jump Byte   Name Of');
  797.   SetCol(7); PutTxt('Offset Work? Work? Map^  Ofset : Addr Cnt   Procedure');
  798.   SetCol(7); PutTxt('------ ----- ----- ----- ----- : ---- ----  ----------');
  799. END; {ProcHeadings}
  800.  
  801. PROCEDURE FormatProcMap(UPt:UnitPtr);                            {.CP31}
  802. VAR     Base, I, J, OldTabStop : Word;
  803. BEGIN {FormatProcMap}
  804.     NoteBegin('Formatting PROC Map');
  805.     OldTabStop := TabStop;
  806.     TabStop := 40;
  807.     SetCol(1);
  808.     IF CountPMapSlots(UPt) > 0 THEN  { Make Sure PROC Map not empty }
  809.     BEGIN
  810.         PrintTitleBlk('PROC Map Table',7);
  811.         NextLL := Upt^.UHPMT;
  812.         I := 0; Base := NextLL;
  813.         ProcHeadings;
  814.         REPEAT
  815.             PageOverFlow(3,PROCHeadings);
  816.                         FetchMapRef(Map,rPROC,I);
  817.             PrintCodeBytes(UPt,8,8,Base,False);
  818.             SetCol(TabStop);
  819.             PutTxt(HexW(Map.MapEPT)+' ');
  820.             PutTxt(HexW(Map.MapSiz)+'  ');
  821.             IF I = 0 THEN
  822.                 IF Map.MapCSM = $FFFF
  823.                 THEN PutTxt('Not Used (No Unit Init Code)')
  824.                 ELSE PutTxt('Unit Init Code')
  825.             ELSE PutTxt(NameOfMethod(UPt,Map.MapOwn));
  826.             Inc(I,SizeOf(PMapRec));
  827.         UNTIL NextLL >= Upt^.UHCMT;
  828.     END;
  829.     TabStop := OldTabStop;
  830.     NoteEnd;
  831. END; {FormatProcMap}
  832.  
  833. PROCEDURE CONSTHeadings; Far;                                   {.CP51}
  834. BEGIN
  835.   SetCol(7); PutTxt('Entry  Turbo Segmt FixUp  VMT  : Load [Fix-Ups]');
  836.   SetCol(7); PutTxt('Offset Work? Bytes Bytes Owner : ADDR 1''st last');
  837.   SetCol(7); PutTxt('------ ----- ----- ----- ----- : ---- ---- ----');
  838. END; {CONSTHeadings}
  839.  
  840. PROCEDURE FormatTypedConMap(UPt:UnitPtr);            {.CP44}
  841. VAR I, J, K : Integer; Sofs, Base : Word;
  842. BEGIN { FormatTypedConMap }
  843.     NoteBegin('Formatting CONST DSeg Map');
  844.     J := CountDMapSlots(UPt);
  845.     IF J > 0 THEN
  846.     BEGIN
  847.         PrintTitleBlk('CONST DSeg Map Table',7);
  848.         K := TabStop;
  849.         TabStop := 56;
  850.         NextLL := Upt^.UHTMT;
  851.         Base := NextLL; Sofs := 0;
  852.         CONSTHeadings;
  853.         FOR I := 0 TO J-1 DO
  854.         BEGIN
  855.             PageOverFlow(7,ConstHeadings);
  856.                         FetchMapRef(Map,rCONS,Sofs);
  857.             PrintCodeBytes(UPt,8,8,Base,False);
  858.                         PutTxt('  '+HexW(Map.MapLod)+' ');
  859.                         If Map.MapFxJ > 0 Then
  860.                         Begin
  861.                              PutTxt(HexW(Map.MapFxI)+' ');
  862.                              PutTxt(HexW(Map.MapFxJ));
  863.                         End;
  864.             SetCol(TabStop);
  865.             IF (Map.MapTyp = mfTVMT)
  866.             THEN PutTxt('VMT For: '+NameOfObject(UPt,Map.MapOwn)) ELSE
  867.                         Begin
  868.                            PutTxt('From: ');
  869.                            Case Map.MapTyp Of
  870.                              mfXTRN: PutTxt('Linked File');
  871.                              mfINTF: PutTxt('_INTERFACE');
  872.                              mfIMPL: PutTxt('_IMPLEMENTATION');
  873.                              mfNEST: PutTxt('PROC('
  874.                                      +NameOfMethod(Upt,Map.MapOwn)+')');
  875.                              Else    PutTxt('???');
  876.                            End;
  877.                         End;
  878.                         Inc(Sofs,SizeOf(DMapRec));
  879.         END; { FOR }
  880.         TabStop := K;
  881.     END; { IF }
  882.     NoteEnd;
  883. END;  { FormatTypedConMap }
  884.  
  885. PROCEDURE VARHeadings; Far;                                     {.CP42}
  886. BEGIN
  887.     SetCol(7); PutTxt('Entry  Turbo Segmt Usage Usage');
  888.     SetCol(7); PutTxt('Offset Work? Bytes  ???   ??? ');
  889.     SetCol(7); PutTxt('------ ----- ----- ----- -----');
  890. END; {VARHeadings}
  891.  
  892. PROCEDURE FormatGlobalVarMap(U : UnitPtr);
  893.  
  894. VAR Base, Sofs, I : Word; SaveTab : Integer;
  895. BEGIN
  896.     NoteBegin('Formatting Global VAR Map');
  897.     SaveTab := TabStop;
  898.     TabStop := 40;
  899.     IF U^.UHDMT <> U^.UHLDU THEN
  900.     BEGIN
  901.         I := 0;
  902.         PrintTitleBlk('Global VAR DSeg Map Table',5);
  903.         VARHeadings;
  904.         NextLL := U^.UHDMT;
  905.         Base := NextLL;
  906.                 Sofs := 0;
  907.         WHILE U^.UHLDU > NextLL DO
  908.         BEGIN
  909.             PageOverFlow(5,VARHeadings);
  910.             PrintCodeBytes(U,8,8,Base,False);
  911.             SetCol(TabStop);
  912.                         FetchMapRef(Map,rVARS,Sofs);
  913.                         PutTxt('From: ');
  914.                         Case Map.MapTyp Of
  915.                           mfXTRN: PutTxt('Linked File');
  916.                           mfINTF: PutTxt('_INTERFACE');
  917.                           mfIMPL: PutTxt('_IMPLEMENTATION');
  918.                           Else    PutTxt('???');
  919.                         End;
  920.                         Inc(Sofs,SizeOf(DMapRec));
  921.             Inc(I);
  922.         END;
  923.     END;
  924.     TabStop := SaveTab;
  925.     NoteEnd;
  926. END; {FormatGlobalVarMap}
  927.  
  928. PROCEDURE FormatUnitDonorList(U : UnitPtr);            {.CP22}
  929. VAR UCP : UDonorPtr; UNE : LL;
  930. BEGIN
  931.     NoteBegin('Formatting Donor Unit List');
  932.     SetCol(1);
  933.     IF U^.UHLSF <> NextLL THEN
  934.     BEGIN
  935.         PrintTitleBlk('Code/Data Donor Unit List',2);
  936.         UCP := UDonorPtr(PtrAdjust(U,U^.UHLDU));
  937.         WHILE NextLL <> U^.UHLSF DO WITH UCP^ DO BEGIN
  938.             IF LinesRemaining < 2 THEN NewTxtPage;
  939.             UNE := FormLL(U,UCP)+SizeOf(UCP^.UDExxx) + 1 + Ord(UDEnam[0]);
  940.             PrintWd(U,'Offset='+HexW(NextLL-U^.UHLDU)+', TURBO Work?');
  941.             PrintBytes(U,1+Ord(UDEnam[0]),9);
  942.             SetCol(TabStop);
  943.             PutTxt('=''' + UDEnam + '''');
  944.             SetCol(1);
  945.             UCP := UDonorPtr(PtrAdjust(U,UNE));
  946.         END;
  947.     END;
  948.     NoteEnd;
  949. END; {FormatUnitDonorList}
  950.  
  951. PROCEDURE FormatSourceFileList(U : UnitPtr);                    {.CP52}
  952. VAR S : SrcFilePtr; SLL : LL; StA : String[10]; StW : String[4];
  953.     OldTabStop : Integer;
  954.  
  955.     PROCEDURE FormatTime(Time : Word);
  956.     VAR I : Integer;
  957.     BEGIN
  958.         Str( Time SHR 11:2,StA);         StA := StA + ':';
  959.         Str((Time AND 2047) SHR 5:2,StW);StA := StA + StW + ':';
  960.         Str((Time AND 31) SHL 1:2,StW);  StA := StA + StW;
  961.         FOR I := 1 TO 7 DO IF StA[I] = ' ' THEN StA[I] := '0';
  962.     END; {FormatTime}
  963.  
  964.     PROCEDURE FormatDate(Date : Word);
  965.     VAR I : Integer;
  966.     BEGIN
  967.         Str((Date AND 511)SHR 5:2,StA); StA := StA + '/';
  968.         Str( Date AND 31:2,StW);        StA := StA + StW + '/';
  969.         Str((Date SHR 9) + 1980:4,StW); StA := StA + StW;
  970.         FOR I := 1 TO 4 DO IF StA[I] = ' ' THEN StA[I] := '0';
  971.     END; {FormatDate}
  972.  
  973. BEGIN {FormatSourceFileList}
  974.     NoteBegin('Formatting Source File List');
  975.     OldTabStop := TabStop;
  976.     TabStop := 48;
  977.     PrintTitleBlk('Source File List',5);
  978.     SLL := U^.UHDBT;
  979.     S := SrcFilePtr(PtrAdjust(U,NextLL));
  980.     WHILE SLL <> NextLL DO WITH S^ DO BEGIN
  981.         IF LinesRemaining < 5 THEN NewTxtPage;
  982.         PrintSoloByte(U,'Flag');
  983.         PrintWd(U,'TURBO Work?');
  984.         CASE SrcFlag OF
  985.             $03,$04:         { .PAS OR .INC file }
  986.                 BEGIN
  987.                     FormatTime(SrcTime); PrintWd(U,'Time-Stamp='+StA);
  988.                     FormatDate(SrcDate); PrintWd(U,'Date-Stamp='+StA);
  989.                 END
  990.             ELSE    BEGIN
  991.                     PrintBytes(U,4,9);SetCol(TabStop);
  992.                     PutTxt('NO Time, Date-Stamps');
  993.                 END
  994.         END;   { CASE }
  995.         PrintBytes(U,1+Ord(SrcName[0]),13);
  996.         SetCol(TabStop);PutTxt('='''+SrcName+'''');
  997.         SetCol(1);
  998.         S := AddrNxtSrc(U,S);
  999.     END;
  1000.     TabStop := OldTabStop;
  1001.     NoteEnd;
  1002. END; {FormatSourceFileList}
  1003.  
  1004. PROCEDURE FormatTraceTable(U : UnitPtr);                        {.CP38}
  1005. VAR    T : TraceRecPtr; S,X : String[6]; I,J, Limit : Word;
  1006. BEGIN
  1007.     NoteBegin('Formatting Trace Table');
  1008.     SetCol(1);
  1009.     T := AddrTraceTab(U);
  1010.     IF T <> Nil THEN
  1011.     BEGIN
  1012.         Limit := GetTrExecSize(T);
  1013.         PrintTitleBlk('Trace Table for Turbo Debugger is Next (LL at 001A)',
  1014.                 7+(Limit SHR 3));
  1015.         WHILE T <> Nil DO WITH T^ DO BEGIN
  1016.             Limit := GetTrExecSize(T);
  1017.             IF LinesRemaining < (7+Limit SHR 3) THEN NewTxtPage;
  1018.             IF TrName <> 0
  1019.             THEN PrintLL(U,NameOfMethod(U,TrName))
  1020.             ELSE PrintWd(U,'Unit Init Code Block');
  1021.             PrintWd(U,'Src File: "' + AddrSrcTabOff(U,TrFill)^.SrcName + '"');
  1022.             Str(T^.TrPfx,S);  PrintWd(U,S+' Data bytes precede Code');
  1023.             Str(T^.TrBeg,S);  PrintWd(U,'BEGIN Stmt at Line # '+S);
  1024.             Str(T^.TrLNos,S); PrintWd(U,S+' Lines of Code to Execute');
  1025.             I := 1;
  1026.             WHILE I <= Limit DO BEGIN
  1027.                 J := I + 7;
  1028.                 IF J > Limit THEN J := Limit;
  1029.                 Str(I-1+TrBeg,S); Str(J-1+TrBeg,X);
  1030.                 PrintBytes(U,J+1-I,8);
  1031.                 SetCol(TabStop);
  1032.                 PutTxt('Code Bytes in Lines '+S+' Thru '+X);
  1033.                 NewTxtLine;
  1034.                 I := J + 1;
  1035.             END;
  1036.             T := AddrNxtTrace(U,T);
  1037.             NewTxtLine;
  1038.         END;
  1039.     END;
  1040.     NoteEnd;
  1041. END; {FormatTraceTable}
  1042.  
  1043. PROCEDURE FormatEndNonCode(U : UnitPtr);                        {.CP05}
  1044. BEGIN
  1045.     PrintTitleBlk('End Non-Code Part Of Unit (LL at 001C)',0);
  1046.     BoundaryAlign(U);
  1047. END; {FormatEndNonCode}
  1048.  
  1049. PROCEDURE FormatObjectCode(UH : UnitPtr);            {.CP07}
  1050. VAR
  1051.    HexOff: Word;  MyFil, MyOrg, MyEnd, MyTrc: LL; SaveTab: Word;
  1052.    CMaps, CXs, I, J: Integer; SF: Byte;
  1053.    PM: MapRefRec; SP: SrcFilePtr; R: FixUpPtr;
  1054.  
  1055.    PROCEDURE DisplayCode(U : UnitPtr; Count: Word;TrcNdx:LL);
  1056.  
  1057.     PROCEDURE DisplayCodeLine(VAR P : ObjArg);        {.CP19}
  1058.     BEGIN
  1059.        WITH P DO WHILE Lim > 0 DO BEGIN
  1060.           UnAssemble(U,P);
  1061.           NextLL := Locn;
  1062.           PrintOffset(HexOff);
  1063.           SetCol(14);    PutTxt(Code);
  1064.           SetCol(37);    PutTxt(Mnem);
  1065.           SetCol(53);    PutTxt(Opr1);
  1066.           IF Length(Opr2) > 0 THEN PutTxt(','+Opr2);
  1067.           IF Length(Opr3) > 0 THEN
  1068.           BEGIN
  1069.              IF Opr3[1] <> ';' THEN PutTxt(',')
  1070.                     ELSE PutTxt(' ');
  1071.          PutTxt(Opr3)
  1072.           END;
  1073.           NewTxtLine;
  1074.        END;
  1075.     END;    {DisplayCodeLine}
  1076.  
  1077.    VAR P: ObjArg; I, J, K, L: Word; Limit, IP: LL;        {.CP42}
  1078.        T: TraceRecPtr; S: String[6];
  1079.    BEGIN   {DisplayCode}
  1080.       IF Count > 0 THEN
  1081.       BEGIN
  1082.          Limit := Count;
  1083.      IP  := NextLL;
  1084.      P.TCpu := CPUType;
  1085.      T := AddrTraceTab(U);
  1086.      IF (T = Nil) OR (TrcNdx = $FFFF) THEN
  1087.      BEGIN
  1088.         P.Lim := Limit;
  1089.         P.Obj := IP;
  1090.         DisplayCodeLine(P);
  1091.         IP  := P.Obj;
  1092.      END ELSE
  1093.      BEGIN
  1094.         T := Ptr(Seg(T^),Ofs(T^)+TrcNdx);
  1095.         L := T^.TrBeg;
  1096.         K := GetTrExecSize(T);
  1097.         P.Obj := IP;
  1098.         I := 1;
  1099.         WHILE I <= K DO BEGIN
  1100.         IF T^.TrExec[I] = $80 THEN Inc(I);
  1101.         P.Lim := T^.TrExec[I];
  1102.         IF P.Lim > 0 THEN
  1103.         BEGIN
  1104.            PutTxt('; ------------> Code From Line: ');
  1105.            Str(L,S);
  1106.            PutTxt(S);
  1107.            IF I = 1 THEN PutTxt('  ("BEGIN" Statement)') ELSE
  1108.            IF I = K THEN PutTxt('  ("END" Statement)');
  1109.            NewTxtLine;
  1110.            DisplayCodeLine(P);
  1111.         END;
  1112.         Inc(L); Inc(I);
  1113.         END;
  1114.         IP := P.Obj;
  1115.      END;
  1116.      NextLL := IP;
  1117.       END;
  1118.    END; {DisplayCode}
  1119.  
  1120.    PROCEDURE UnAssembleCode(Hash: LL; SF: Byte;            {.CP31}
  1121.               Org, Limit: Word;
  1122.                  TrcNdx: LL; Comment: Boolean; MT:MapFlags);
  1123.    VAR Stopper : LL;
  1124.    BEGIN
  1125.       IF LinesRemaining < 4 THEN NewTxtPage;
  1126.       Stopper := Limit-Org;
  1127.       IF NextLL > Org THEN Stopper := Limit-NextLL;
  1128.       IF (Stopper > 0) THEN
  1129.       BEGIN
  1130.     IF Comment THEN {Allow Remarks}
  1131.     BEGIN
  1132.        SetCol(7); PutTxt('Code For ');
  1133.        IF SF < $05
  1134.        THEN
  1135.          IF (Hash <> $FFFF) AND (Hash <> 0)
  1136.          THEN PutTxt('PROC "'+NameOfMethod(UH,Hash)+'"')
  1137.          ELSE If MT = mfPRUI
  1138.               Then PutTxt('Unit Initialization')
  1139.                   Else PutTxt('Implementation PROC')
  1140.        ELSE
  1141.          IF (Hash <> $FFFF) AND (Hash <> 0)
  1142.          THEN PutTxt('PUBLIC "'+NameOfMethod(UH,Hash)+'"')
  1143.          ELSE PutTxt('PRIVATE or Un-named PUBLIC');
  1144.        PutTxt(' starts at '+HexW(NextLL));
  1145.        NewTxtLine;NewTxtLine;
  1146.     END;
  1147.     IF DisAssembly
  1148.     THEN DisplayCode(UH,Stopper,TrcNdx)
  1149.     ELSE PrintCodeBytes(UH,Stopper,16,HexOff,True);
  1150.     NewTxtLine;NewTxtLine;
  1151.       END;
  1152.    END;  {UnAssembleCode}
  1153.  
  1154.    PROCEDURE UnAssembleData(S: MapRefRec; SF: Byte);        {.CP13}
  1155.    BEGIN
  1156.      SetCol(7);
  1157.      IF SF <> $05
  1158.      THEN PutTxt('(Preamble Data Begins at ')
  1159.      ELSE PutTxt('(PRIVATE Code or Data Begins at ');
  1160.      PutTxt(HexW(NextLL)+')');
  1161.      NewTxtLine;NewTxtLine;
  1162.      IF SF <> $05
  1163.      THEN PrintCodeBytes(UH,S.MapEPT-NextLL,16,HexOff,True)
  1164.      ELSE UnAssembleCode(S.MapOwn,SF,NextLL,S.MapEPT,$FFFF,False,S.MapTyp);
  1165.      NewTxtLine;NewTxtLine;
  1166.    END;  {UnAssembleData}
  1167.  
  1168. BEGIN  {FormatObjectCode}                                       {.CP53}
  1169.    NoteBegin('Formatting CODE Segments');
  1170.    IF UH^.UHCMT < UH^.UHTMT THEN
  1171.    BEGIN
  1172.       SaveTab := TabStop;
  1173.       TabStop := 55;
  1174.       R := AddrFixUps(UH);
  1175.       PrintTitleBlk('Object Code Begins Here',0);
  1176.       CMaps := CountCMapSlots(UH)  *SizeOf(CMapRec);   { Code Segments }
  1177.       CXs := (CountPMapSlots(UH)-1)*SizeOf(PMapRec);
  1178.       SortProcRefs(CSegOrder);
  1179.       FetchMapRef(Map,rPROC,CXs);
  1180.       IF (Map.MapEPT = $FFFF)        { remove unused init proc  }
  1181.       THEN Dec(CXs,SizeOf(PMapRec));
  1182.       I := 0;                        { Track PMRefs Table           }
  1183.       J := 0;                        { Track CSeg Map Table     }
  1184.  
  1185.       REPEAT
  1186.          NewTxtLine;
  1187.          FetchMapRef(Map,rCSEG,J);
  1188.          FetchMapRef(PM,rPROC,I);
  1189.      WHILE PM.MapCSM < J DO Begin
  1190.             Inc(I,SizeOf(PMapRec));
  1191.             FetchMapRef(PM,rPROC,I);
  1192.          End;
  1193.      MyOrg := Map.MapLod;            { Segment Load Point }
  1194.      MyEnd := MyOrg + PM.MapSiz;        { Next Segment Start }
  1195.      MyFil := Map.MapSrc;            { Segment Source Fil }
  1196.      MyTrc := AddrCMapTab(UH)^[PM.MapCSM DIV SizeOf(CMapRec)].CsegTrc;
  1197.      SP := AddrSrcTabOff(UH,MyFil);
  1198.      PutTxt('----  Code Segment at '+HexW(NextLL)+' Found In "');
  1199.      PutTxt(SP^.SrcName+'"');
  1200.      NewTxtLine; NewTxtLine;
  1201.      HexOff := NextLL;
  1202.      SF := SP^.SrcFlag;
  1203.      IF (PM.MapEPT <> NextLL)
  1204.      THEN UnAssembleData(PM,SF);
  1205.      WHILE (I <= CXs) AND (PM.MapCSM = J) DO BEGIN
  1206.          WITH PM DO
  1207.         UnAssembleCode(MapOwn,SF,MapEPT,MapEPT+MapSiz,MyTrc,True,MapTyp);
  1208.         Inc(I,SizeOf(PMapRec));
  1209.             FetchMapRef(PM,rPROC,I);
  1210.      END;
  1211.      Inc(J,SizeOf(CMapRec));
  1212.       UNTIL (J >= CMaps);
  1213.  
  1214.       TabStop := SaveTab;
  1215.       SetCol(1);PutTxt('----  END OF ALL OBJECT CODE');
  1216.       NewTxtLine;NewTxtLine;
  1217.       BoundaryAlign(UH);
  1218.    END;
  1219.    NoteEnd;
  1220. END; {FormatObjectCode}
  1221.  
  1222. PROCEDURE FormatDataAreas(UH : UnitPtr);            {.CP44}
  1223. VAR    PD : DMapTabPtr; SaveTab : Word; T : TypePtr;
  1224.     I, MapEnd,Base : Word; EndLL : LL; S : MapRefRec;
  1225. BEGIN
  1226.    NoteBegin('Formatting CONST Data Segments');
  1227.    SaveTab := TabStop;
  1228.    EndLL := NextLL + UH^.UHZDT;
  1229.    IF EndLL <> NextLL THEN
  1230.    BEGIN
  1231.       PrintTitleBlk('CONST Data Segments Follow',5);
  1232.       WITH UH^ DO MapEnd := (UHDMT-UHTMT) DIV SizeOf(DMapRec);
  1233.       PD := AddrDMapTab(UH);
  1234.       FOR I := 0 TO MapEnd-1 DO WITH PD^[I] DO BEGIN
  1235.      NewTxtLine;
  1236.      SetCol(7);
  1237.      IF DSegOwn <> 0 THEN
  1238.      BEGIN
  1239.         T := TypePtr(PtrAdjust(UH,DSegOwn));
  1240.         PutTxt('VMT Template for "');
  1241.         PutTxt(AddrDict(UH,T^.ObjtName)^.DSymb+'"');
  1242.      END ELSE
  1243.          Begin
  1244.             FetchMapRef(S,rCONS,SizeOf(DMapRec)*I);
  1245.             PutTxt('Typed CONST''s From: ');
  1246.             Case S.MapTyp Of
  1247.                mfXTRN: PutTxt('Linked File');
  1248.                mfINTF: PutTxt('_INTERFACE');
  1249.                mfIMPL: PutTxt('_IMPLEMENTATION');
  1250.                mfNEST: PutTxt('PROC('+NameOfMethod(UH,S.MapOwn)+')');
  1251.                Else    PutTxt('???');
  1252.             End;
  1253.          End;
  1254.      Base := NextLL;
  1255.      SetCol(1);
  1256.      PrintCodeBytes(UH,DSegCnt,16,Base,True);
  1257.      SetCol(1);
  1258.       END; {FOR}
  1259.       NewTxtLine;PutTxt('----  END OF ALL DATA SEGMENTS');
  1260.       NewTxtLine;NewTxtLine;
  1261.    END; {IF}
  1262.    TabStop := SaveTab;
  1263.    BoundaryAlign(UH);
  1264.    NoteEnd;
  1265. END; {FormatDataAreas}
  1266.  
  1267. PROCEDURE FixUpHeadings; Far;                    {.CP06}
  1268. BEGIN
  1269.    SetCol(7); PutTxt('Un Fl  Map  E-Adr Patch : Ptch Type Refers');
  1270.    SetCol(7); PutTxt('it ag Ofset Ofset Ofset : Size  Map To Unit');
  1271.    SetCol(7); PutTxt('-- -- ----- ----- ----- : ---- ---- --------');
  1272. END; {FixUpHeadings}
  1273.  
  1274. PROCEDURE FormatFixUpList(UH : UnitPtr);            {.CP02}
  1275. TYPE Remark = String[8]; T4 = String[4]; T8 = String[8];
  1276.  
  1277.     PROCEDURE FixUpIdentify(    R : FixUpRec;           {.CP17}
  1278.                 VAR S2, S1 : T4; VAR S3 : T8);
  1279.     VAR PU : UDonorPtr;
  1280.     BEGIN  {FixUpIdentify}
  1281.        CASE (R.FixFlg SHR 6) AND $3 OF
  1282.            0: S1 := 'PROC';    1: S1 := 'CSeg';
  1283.         2: S1 := 'DATA';    3: S1 := 'CONS';
  1284.        END;
  1285.        CASE (R.FixFlg SHR 4) AND $3 OF
  1286.            0: S2 := 'WORD';    1: S2 := 'WD+E';
  1287.         2: S2 := 'SEG ';    3: S2 := 'FPTR';
  1288.        END;
  1289.        IF (R.FixFlg AND $F) <> 0 THEN
  1290.        BEGIN S1 := '??? ';    S2 := '????';  END;
  1291.        PU := UDonorPtr(PtrAdjust(UH,UH^.UHLDU+R.FixDnr));
  1292.        S3 := PU^.UDENam;
  1293.     END;   {FixUpIdentify}
  1294.  
  1295. VAR  R: FixUpPtr; T: TypePtr; PU: UDonorPtr; S: MapRefRec;    {.CP47}
  1296.      RR: FixUpRecPtr; EndS, EndLL: LL; S1, S2: T4; S3: T8;
  1297.      I, J, K, MapEnd: Word; SaveTab: Word; OV: HeadProc;
  1298. BEGIN
  1299.    NoteBegin('Formatting Fix-Up List');
  1300.    SaveTab := TabStop;
  1301.    TabStop := 33;
  1302.    EndLL := NextLL + UH^.UHZFA;
  1303.    IF EndLL <> NextLL THEN WITH UH^ DO
  1304.    BEGIN
  1305.       PrintTitleBlk('Fix-Up List Follows',7);
  1306.       SetCol(1);
  1307.       J := 0;
  1308.       R := FixUpPtr(PtrAdjust(UH,NextLL));
  1309.       IF UHCMT < UHTMT THEN
  1310.       BEGIN
  1311.          MapEnd := UHTMT-UHCMT; I := 0;
  1312.      While I < MapEnd DO Begin
  1313.             FetchMapRef(Map,rCSEG,I);
  1314.         IF Map.MapFxJ <> 0 THEN
  1315.         BEGIN
  1316.            SetCol(1);
  1317.            IF LinesRemaining < 9 THEN NewTxtPage
  1318.                             ELSE NewTxtLine;
  1319.            SetCol(7);
  1320.            EndS := Map.MapLod;
  1321.            PutTxt('Segment Load Addr = ' + HexW(EndS));
  1322.                SetCol(7);
  1323.            EndS := EndS + Map.MapSiz;
  1324.            PutTxt('Fix-Up''s For CSeg Map Entry at ' + HexW(I + UHCMT));
  1325.            SetCol(1);NewTxtLine;
  1326.            FixUpHeadings;
  1327.                K := Map.MapFxI;
  1328.            While K <= Map.MapFxJ DO BEGIN
  1329.                   RR := PtrAdjust(UH,K);
  1330.           PageOverFlow(2,FixUpHeadings);
  1331.           FixUpIdentify(RR^,S1,S2,S3);
  1332.           PrintBytes(UH,8,8);
  1333.           SetCol(TabStop);   PutTxt(S1);
  1334.           SetCol(TabStop+5); PutTxt(S2);
  1335.           SetCol(TabStop+10);PutTxt(S3);
  1336.           Inc(K,SizeOf(FixUpRec));
  1337.            END; {While}
  1338.             End; {IF}
  1339.             Inc(I,SizeOf(CMapRec));
  1340.      END;  {While}
  1341.       END;   { IF CSeg Map non-Empty }
  1342.  
  1343.       IF UHTMT < UHDMT THEN    {DSeg Map non-Empty}        {.CP58}
  1344.       BEGIN
  1345.     NewTxtLine;NewTxtLine;
  1346.     BoundaryAlign(UH);
  1347.     K := NextLL;
  1348.     MapEnd := UHDMT-UHTMT;
  1349.     EndS := 0;
  1350.         I := 0;
  1351.     While I < MapEnd DO Begin
  1352.            FetchMapRef(Map,rCONS,I);
  1353.        IF Map.MapFxJ <> 0 THEN
  1354.        BEGIN
  1355.           SetCol(1);
  1356.           IF LinesRemaining < 9 THEN NewTxtPage
  1357.                           ELSE NewTxtLine;
  1358.           SetCol(7);
  1359.               If Map.MapTyp = mfTVMT
  1360.           THEN PutTxt('VMT Fix-Up''s For: '+NameOfObject(UH,Map.MapOwn))
  1361.               Else Begin
  1362.                 PutTxt('Typed CONST Fix-Up''s for: ');
  1363.                 Case Map.MapTyp Of
  1364.                    mfXTRN: PutTxt('Linked File');
  1365.                    mfINTF: PutTxt('_INTERFACE');
  1366.                    mfIMPL: PutTxt('_IMPLEMENTATION');
  1367.                    mfNEST: PutTxt('PROC('+NameOfMethod(UH,Map.MapOwn)+')');
  1368.                    Else    PutTxt('???');
  1369.                 End {case}
  1370.               End;
  1371.               NewTxtLine;NewTxtLine;
  1372.               EndS := Map.MapLod;
  1373.           PutTxt('Seg Load Addr = ' + HexW(EndS) + ' --');
  1374.               Inc(EndS,Map.MapSiz);
  1375.           PutTxt(' CONST DSeg Map Entry at '+ HexW(I+UHTMT));
  1376.           SetCol(1);NewTxtLine;
  1377.           FixUpHeadings;
  1378.           K := Map.MapFxI;
  1379.           WHILE K <= Map.MapFxJ DO BEGIN
  1380.              PageOverFlow(2,FixUpHeadings);
  1381.                  RR := PtrAdjust(UH,K);
  1382.          FixUpIdentify(RR^,S1,S2,S3);
  1383.          PrintBytes(UH,8,8);
  1384.          SetCol(TabStop);   PutTxt(S1);
  1385.          SetCol(TabStop+5); PutTxt(S2);
  1386.          SetCol(TabStop+10);PutTxt(S3);
  1387.          Inc(K,SizeOf(FixUpRec));
  1388.           END; {WHILE}
  1389.        END; {If Fixups to print}
  1390.            Inc(I,SizeOf(DMapRec));
  1391.         End; {While}
  1392.       END;   { IF DSeg Map non-Empty }
  1393.       NewTxtLine;NewTxtLine;
  1394.       PutTxt('----  END OF FIX-UP LIST');
  1395.       NewTxtLine;NewTxtLine;
  1396.    END;   {IF FixUp List non-Empty}
  1397.    TabStop := SaveTab;
  1398.    BoundaryAlign(UH);
  1399.    NoteEnd;
  1400. END; {FormatFixUpList}
  1401.  
  1402. PROCEDURE DocumentUnit(P : UnitPtr);                {.CP16}
  1403. BEGIN
  1404.     FormatHeader(P);
  1405.     FormatDictionary(P);        { PRINT the Dictionary     }
  1406.     FormatProcMap(P);               { PRINT the PROC Map       }
  1407.     FormatCSegMap(P);               { PRINT the CSeg Map       }
  1408.     FormatTypedConMap(P);        { PRINT the CONST Map      }
  1409.     FormatGlobalVarMap(P);        { PRINT the VAR Map        }
  1410.     FormatUnitDonorList(P);        { PRINT the Donor Unit Tab }
  1411.     FormatSourceFileList(P);    { PRINT the Source Files   }
  1412.     FormatTraceTable(P);        { PRINT the Trace Table    }
  1413.     FormatEndNonCode(P);        { PRINT separator          }
  1414.     FormatObjectCode(P);        { PRINT CODE Segments      }
  1415.     FormatDataAreas(P);        { PRINT CONST Segment Data }
  1416.     FormatFixUpList(P);        { PRINT LINKER FixUp Data  }
  1417. END; {DocumentUnit}
  1418.  
  1419. VAR i,j : integer; P: UnitPtr; Module: String[8]; c: char;    {.CP50}
  1420.     K: LongInt;   NS: String[5];
  1421.  
  1422. BEGIN       { Main Program }
  1423.     ClrScr;
  1424.     Write('Enter Name of Unit to Document: ');ReadLn(Module);
  1425.     i := WhereX; j := WhereY;
  1426.     REPEAT
  1427.         GoToXY(i,j);ClrEol;
  1428.         Write('Do You Want Dis-Assembly of Code? [Y|N] ');
  1429.         ReadLn(c);
  1430.     UNTIL UpCase(c) IN ['Y','N'];
  1431.     DisAssembly := UpCase(c) = 'Y';
  1432.     i := WhereX; j := WhereY;
  1433.         IF DisAssembly Then Begin
  1434.        REPEAT
  1435.         GoToXY(i,j);ClrEol;
  1436.         Write('What CPU? (0=8086,1=80186,2=80286,3=80386) ');
  1437.         ReadLn(c);
  1438.        UNTIL c IN ['0'..'3'];
  1439.        Case C Of '0': CPUType := C086; '1': CPUType := C186;
  1440.                     '2': CPUType := C286; '3': CPUType := C386;
  1441.            End; {Case}
  1442.         End;
  1443.     FOR I := 1 TO Length(Module) DO Module[I] := UpCase(Module[I]);
  1444.     TabStop := 36;
  1445.     OpenTxt(Module+'.LST',59,80);
  1446.         NoteBegin(''); JobTime := NoteTime;
  1447.         NoteBegin('Starting Analysis of "'+Module+'"');
  1448.         P := AnalyzeUnit(Module,'');
  1449.         NoteEnd;
  1450.     IF P <> Nil THEN
  1451.     BEGIN
  1452.         PutTxt('==========================');   NewTxtLine;
  1453.         PutTxt('* Analysis of: "'
  1454.         + DNamePtr(PtrAdjust(P,P^.UHUDH))^.DSymb + '"'); NewTxtLine;
  1455.         PutTxt('==========================');   NewTxtLine;
  1456.         NextLL := 0;
  1457.         DocumentUnit(P); NewTxtPage;
  1458.     END ELSE
  1459.         BEGIN
  1460.             WriteLn;
  1461.         WriteLn('Unit "',module,'" Not Found!');
  1462.                 WriteLn;
  1463.         End;
  1464.  
  1465.         PutTxt('Heap Utilization Summary');NewTxtLine;
  1466.         K := PtrDelta(HeapEnd,HeapOrg);
  1467.     Str(K/1024.0:5:1, NS);
  1468.         NewTxtLine; PutTxt(NS+' Kb Available at Start');
  1469.         K := PtrDelta(_HeapHighWaterMark,_HeapOriginalMark);
  1470.     Str(K/1024.0:5:1, NS);
  1471.         NewTxtLine; PutTxt(NS+' Kb used during Analyses');
  1472.         K := PtrDelta(HeapPtr,HeapOrg);
  1473.     Str(K/1024.0:5:1, NS);
  1474.         NewTxtLine; PutTxt(NS+' Kb in use during print');
  1475.         PurgeAllUnits;
  1476.         NewTxtLine; PutTxt('---- End Report');
  1477.         NewTxtPage;
  1478.     CloseTxt;
  1479.         NoteBegin('');
  1480.         Write('End of Job');
  1481.         NoteTime := JobTime;
  1482.         NoteEnd;
  1483. END.